(use-modules (srfi srfi-37))

(define options (make-hash-table 10))

(define (display-and-exit-proc msg)
  (lambda (opt name arg loads)
    (display msg)
    (quit)))

(define* (make-store-in-options-proc #:optional (key #f))
  "Make a processor, which stores the option in the options hash table, optionally taking a key under which to store the value."
  (lambda (opt name arg loads)
    (display
     (simple-format #f
                    "storing the following option and value: ~a, ~a\n"
                    (if key key name)
                    arg))
    (if key
        (hash-set! options key arg)
        (hash-set! options name arg))
    loads))

(define usage-help
  (string-join '(""
                 "foo.scm [options]"
                 "-v,  --version    Display version"
                 "-h,  --help       Display this help"
                 "-u,  --user-name  user name greeted by this program"
                 "-n,  --times      number of greetings"
                 "")
               "\n"))

(define option-spec
  (list (option '(#\v "version") #f #f
                (display-and-exit-proc "Foo version 42.0\n"))
        (option '(#\h "help") #f #f
                (display-and-exit-proc usage-help))
        (option '(#\u "user-name") #t #f
                (make-store-in-options-proc "user-name"))
        (option '(#\n "times") #t #f
                (λ (opt name arg loads)
                  (cond
                   [(exact-integer? (string->number arg))
                    ((make-store-in-options-proc "times") opt name arg loads)]
                   [else
                    (error
                     (simple-format #f
                                    "option predicate for option ~a not true: ~a"
                                    name "(exact-integer? (string->number arg))"))])))))

(args-fold (cdr (program-arguments))
           option-spec
           (lambda (opt name arg loads)
             (error (simple-format #f "Unrecognized option: ~A\n~A" name usage-help)))
           (lambda (op loads)
             (cons op loads))
           '())

(define (main options)
  (let ([user-name (hash-ref options "user-name" #f)]
        [times (string->number (hash-ref options "times" "1"))])
  (do ([i 0 (1+ i)])
      ([>= i times])
    (display (simple-format #f "Hello ~a!\n" (if user-name
                                                  user-name
                                                  "World"))))))

(main options)
